home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Excel and 17833422001.psc / VB With Excel / frmMain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-07-03  |  5.5 KB  |  145 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3195
  10.    ScaleWidth      =   4680
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton cmdExcel 
  13.       Caption         =   "Make Excel File"
  14.       Height          =   495
  15.       Left            =   1680
  16.       TabIndex        =   0
  17.       Top             =   1320
  18.       Width           =   1575
  19.    End
  20. Attribute VB_Name = "frmMain"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = False
  23. Attribute VB_PredeclaredId = True
  24. Attribute VB_Exposed = False
  25. Dim cn              As ADODB.Connection
  26. Dim rs              As ADODB.Recordset
  27. Dim FieldsName()    As String
  28. Dim FieldsValue()   As String
  29. Dim DBfields()      As String
  30. Dim DBvaluse()      As String
  31. Dim Counter         As Integer
  32. Dim FieldsCounter   As Integer
  33. Private Sub cmdExcel_Click()
  34.  Call MakeExcel
  35. End Sub
  36. Private Sub Form_Load()
  37. Set cn = New ADODB.Connection
  38. Set rs = New ADODB.Recordset
  39. '--- Open ADODB Connection ---
  40. cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Db.mdb;Persist Security Info=False"
  41. '--- Get A Recordset - Customer Table
  42. rs.Open "select * from Customer", cn, adOpenDynamic, adLockOptimistic
  43. '--- DBfields - Array To Hold Fields Name ---
  44. '--- Get The Array From MakeArrayFields Function ---
  45. DBfields = MakeArrayFields
  46. '--- DBvaluse - Array To Hold Values In Table ---
  47. '--- Get The Array From MakeArrayValues Function ---
  48. DBvaluse = MakeArrayValues
  49. End Sub
  50. Private Function MakeArrayValues() As Variant
  51. ' ******************************************************************************
  52. ' Routine:           MakeArrayValues
  53. ' Description:       Get Values Of Table To An Array
  54. ' Created by:        gil
  55. ' Machine:           GIL
  56. ' Date-Time:         02/07/00-16:49:07
  57. ' Last modification: last_modification_info_here
  58. ' ******************************************************************************
  59. On Error GoTo ErrHandler
  60.     Dim RowCounter      As Integer
  61.     Dim RowPlace        As Integer 'Row Number In Table
  62.     Dim ColumnPlace     As Integer
  63.     '--- Count Rows In Table ---
  64.     Do Until rs.EOF = True
  65.         RowCounter = RowCounter + 1
  66.         rs.MoveNext
  67.     Loop
  68.     RowPlace = 1 ' Start In Row Number 1
  69.     rs.MoveFirst ' Move REcordset To First The Record
  70.     '--- Declare Array Size ---
  71.     '--- First Rows Number Then Columns Number ---
  72.     ReDim FieldsValue(0 To RowCounter - 1, 0 To FieldsCounter - 1)
  73.     '--- Do This As The Number Of Rows ---
  74.     For RowPlace = 0 To RowCounter - 1
  75.         '--- Do This As The Number Of Fields ---
  76.         For ColumnPlace = 0 To FieldsCounter - 1
  77.             '--- Fill Array With Value ---
  78.             FieldsValue(RowPlace, ColumnPlace) = rs.Fields(ColumnPlace).Value
  79.         Next ColumnPlace
  80.         '--- Move Recordset For The Next Record ---
  81.         rs.MoveNext
  82.     Next RowPlace
  83.     '--- Function Return The full Array ---
  84.     MakeArrayValues = FieldsValue()
  85. Exit Function
  86. ErrHandler:
  87.     MsgBox Err.Number & vbCrLf & Err.Description
  88. End Function
  89. Private Function MakeArrayFields() As Variant
  90. ' ******************************************************************************
  91. ' Routine:           MakeArrayFields
  92. ' Description:       Get Fields Name To An Array
  93. ' Created by:        gil
  94. ' Machine:           GIL
  95. ' Date-Time:         02/07/00-17:05:27
  96. ' Last modification: last_modification_info_here
  97. ' ******************************************************************************
  98. On Error GoTo ErrHandler
  99.     Dim Counter As Integer
  100.     '--- Count Fields In Table ---
  101.     FieldsCounter = rs.Fields.Count
  102.     '--- Declare Array Size ---
  103.     '--- Size Will Be As FieldsCounter ---
  104.     ReDim FieldsName(0 To FieldsCounter - 1)
  105.     Counter = 0
  106.     '--- Do This As The Number Of Fields ---
  107.     For Counter = 0 To FieldsCounter - 1
  108.         '--- Fill Array With Fields Name ---
  109.         FieldsName(Counter) = rs.Fields.Item(Counter).Name
  110.     Next Counter
  111.     '--- Function Return The full Array ---
  112.     MakeArrayFields = FieldsName()
  113. Exit Function
  114. ErrHandler:
  115.     MsgBox Err.Number & vbCrLf & Err.Description
  116. End Function
  117. Public Sub MakeExcel()
  118. ' ******************************************************************************
  119. ' Routine:           MakeExcel
  120. ' Description:       Make The Excel File use DLL
  121. ' Created by:        gil
  122. ' Machine:           GIL
  123. ' Date-Time:         02/07/00-17:12:11
  124. ' Last modification: last_modification_info_here
  125. ' ******************************************************************************
  126. On Error GoTo ErrHandler
  127.     Dim ExcelFileName   As String
  128.     Dim PrintToExcel    As ToExcelFile.ExcelFile
  129.     Set PrintToExcel = New ToExcelFile.ExcelFile
  130.     '--- File Name To Save As Excel File
  131.     ExcelFileName = "xxxxx.xls"
  132.     Screen.MousePointer = vbHourglass
  133.     '--- Call Function From DLL File ---
  134.     '--- To Make The Excel File ---
  135.     '--- It Get 2 Array And Excel File Name ---
  136.     '--- One Array For Fields Name ---
  137.     '--- Second Array With Values ---
  138.     Call PrintToExcel.MakeExcelFile(DBfields(), DBvaluse(), ExcelFileName)
  139.     Screen.MousePointer = vbDefault
  140.     Exit Sub
  141. ErrHandler:
  142.     Screen.MousePointer = vbDefault
  143.     MsgBox Err.Number
  144. End Sub
  145.